Introduction

InRainbows colour palettes …ya da ya da

Required packages

library(tidyverse)
library(jpeg)
library(reshape2)
library(knitr)

Tell knitr to use the parent directory as the working directory (not the directory where the .rmd file is stored).

opts_knit$set(root.dir = "..")

kMeans colour space

Define function to transform an image into tidy coordinate pairs with RGB values.

imTransform <- function(img){
  
  i <- readJPEG(img)
  
  dim_x <- dim(i)[1]
  dim_y <- dim(i)[2]
  
  df <-
    melt(i) %>% 
    spread(Var3, value) %>% 
    rename(red="1", green="2", blue="3") %>% 
    mutate(Var1 = -Var1 + dim_y) %>% 
    rename(x=Var2, y=Var1) %>% 
    mutate(hex = pmap_chr(list(red, green, blue), rgb))
  
  df
}

Read in an album cover

im_df <- imTransform("album_covers/the_bends.jpg")
head(im_df)
y x red green blue hex
599 1 0.0745098 0.2000000 0.1058824 #13331B
599 2 0.0784314 0.2078431 0.1019608 #14351A
599 3 0.0823529 0.2117647 0.1058824 #15361B
599 4 0.0901961 0.2196078 0.0980392 #173819
599 5 0.0980392 0.2313725 0.1019608 #193B1A
599 6 0.1058824 0.2392157 0.1019608 #1B3D1A

Run kmeans

ncols <- 5 # Number of palette colors
kMeans <- kmeans(im_df[c("red", "green", "blue")], ncols)

Assign mean colours to all coordinate pairs

approxCol <- kMeans$centers[kMeans$cluster, ]

Visualise palette

par(mfrow=c(1,3))
plot(im_df$x, im_df$y, col=rgb(im_df[,3:5]), 
     asp = 1, pch=".", axes=F, xlab="", ylab="", main="Original")

plot(im_df$x, im_df$y, col=rgb(approxCol), 
     asp = 1, pch=".", axes=F, xlab="", ylab="", main="Approximate")

palette <- table(rgb(approxCol)) %>% sort(decreasing = T)
barplot(palette, col=names(palette), axes=F, border=NA, main="Palette", las=2)

Wrap all into one function

imPalette <- function(img, ncol=5, my.seed=3, ...){  
  
  i <- readJPEG(img)
  mname <- str_extract(img, "(?<=/)[^.]+")
  
  dim_x <- dim(i)[1]
  dim_y <- dim(i)[2]
  
  df <-
    melt(i) %>% 
    spread(Var3, value) %>% 
    rename(red="1", green="2", blue="3") %>% 
    mutate(Var1 = -Var1 + dim_y) %>% 
    rename(x=Var2, y=Var1) %>% 
    tbl_df()
  
  df$hex <- df %>% select(red, green, blue) %>% pmap_chr(rgb)
  
  # Run Kmeans 
  set.seed(my.seed)
  kMeans <- kmeans(df[c("red", "green", "blue")], ncol, ...)
  
  # Caluclate aproximate colours
  approxCol <- kMeans$centers[kMeans$cluster, ]
  
  # Plot
  par(mfrow=c(1,3))
  plot(df$x, df$y, col=rgb(df[,3:5]), 
       asp = 1, pch=".", axes=F, xlab="", ylab="", main="Original")
  
  plot(df$x, df$y, col=rgb(approxCol), 
       asp = 1, pch=".", axes=F, xlab="", ylab="", main="Approximate")
  
  palette <- table(rgb(approxCol)) %>% sort(decreasing = T)
  barplot(palette, col=names(palette), axes=F, border=NA, main="Palette", las=2)
  
  return(assign(x=mname, value = palette, envir = .GlobalEnv))
  }

Run on all album covers

paste0("album_covers/",list.files("album_covers")) %>% 
  sapply(imPalette, ncol=10) %>% 
  invisible()

## Warning: Quick-TRANSfer stage steps exceeded maximum (= 18000000)

## Warning: Quick-TRANSfer stage steps exceeded maximum (= 12103200)